home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / dfqbx26.zip / DFDEMO.BAS next >
BASIC Source File  |  1992-12-13  |  13KB  |  347 lines
  1. DEFINT A-Z
  2. ' $INCLUDE: '\inc\dframex.inc'          'change path if need be
  3. ' $INCLUDE: '\inc\ownerx.inc'           'contains my serial #. Delete this
  4.                                         'line if necessary.
  5.  
  6. ProgName$ = "DoorFrame Demo"
  7. ExeName$ = "DFDEMO"
  8. Version$ = " 1.1"
  9.  
  10. INITIALIZE
  11. CLOSE #1
  12. DETECT.ANSI                     'Make sure the caller is ANSI capable!
  13. ON ERROR GOTO Err.Routine
  14. SysopKeys% = 1                  'Use alternate set so we can use the arrows
  15. DIM Menu$(8)                    'Holds our Menu entries
  16.  
  17. 'Since this demo uses cursor positioning, the caller must be ANSI compatible.
  18. 'Kick him out if he isn't.
  19. IF Graphics% = 0 THEN
  20.    ClrScrn Black
  21.    DIS.PLAY "This Door requires ANSI.SYS compatibility!", LWHITE, Black, 0, 0, 1, 1, 1, 0, 0, 0
  22.    DIS.PLAY "Returning you to the BBS", LWHITE, Black, 0, 0, 2, 1, 1, 0, 0, 0
  23.    DE.LAY 3
  24.    EXIT.DOOR "Y"
  25. END IF
  26.  
  27. 'Also needs color to see the demo. If not in color mode, ask to switch.
  28.  
  29. PriorMode% = Mode%                      'Save current color mode
  30. IF Mode% = 0 THEN                       'Does he have color on?
  31.    DIS.PLAY "You will need to be in Color Mode to see this demo.", LWHITE, Black, 0, 1, 10, 1, 1, 1, 0, 0
  32.    DIS.PLAY "Type Y to switch to Color or N to return to BBS [Y/n] > ", LWHITE, Black, 0, 0, 12, 1, 0, 1, 0, 0
  33.    IF UCASE$(Response$) <> "N" THEN
  34.       Mode% = -1                        'Turn color on
  35.    ELSE
  36.       EXIT.DOOR "Y"
  37.    END IF
  38. END IF
  39.  
  40. Menu$(1) = "}B}ox.It Demo"
  41. Menu$(2) = "Clr}E}ol Demo"
  42. Menu$(3) = "}C}lrScrn Demo"
  43. Menu$(4) = "}D}is.Play Demo"
  44. Menu$(5) = "}I}n.Put Demo"
  45. Menu$(6) = "Make.Blt Dem}O}"            'Can't use M when SysopKeys% = 1
  46. Menu$(7) = "}S}end Demo"
  47. Menu$(8) = "}G}et me out!"
  48.  
  49. Start:
  50. MenuPos% = 1                    'Where are we on the Menu?
  51. ClrScrn Blue                    'Clear the screen with a BLUE background
  52.  
  53. 'Draw a box for our menu
  54. BOX.IT 5, 30, 16, 50, 2, LWHITE, CYAN, LWHITE, CYAN, 32, 0, "Menu", 0, 7
  55.  
  56. 'Write the menu and highlight bar
  57. FOR x = 1 TO 8
  58.    DIS.PLAY Menu$(x), Black, CYAN, 0, 0, x + 6, 33, 1, 0, 0, 1
  59. NEXT
  60. DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0, 1
  61.  
  62. 'Qmodem redefines the arrow keys. Any feedback on other term programs?
  63. DIS.PLAY "If you are using Qmodem, switch to DoorWay mode to use the arrows.", LWHITE, Blue, 0, 0, 22, 1, 1, 1, 0, 0
  64.  
  65. GetInput:
  66. 'Prompt for a choice. Get a 1-key response and act on it
  67. IN.PUT 1, 0, Lcyan, Blue, 1, "Your Choice? ", Lgreen, Blue, 19, 34, 1
  68.  
  69. SELECT CASE UCASE$(Response$)           'Response$ holds the callers input.
  70. CASE "B"
  71.    GOSUB BoxDemo
  72. CASE "E"
  73.    GOSUB EolDemo
  74. CASE "C"
  75.    GOSUB ClrDemo
  76. CASE "D"
  77.    GOSUB DisplayDemo
  78. CASE "I"
  79.    GOSUB InputDemo
  80. CASE "O"
  81.    GOSUB BltDemo
  82. CASE "S"
  83.    GOSUB SendDemo
  84. CASE "G"
  85.    GOTO GoodBye
  86. CASE "UP"               'Returned in Response$ when using alternate Sysop
  87.                         'keys and the UP Arrow or capital H is pressed.
  88.    DIS.PLAY Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0, 1
  89.    IF MenuPos% = 1 THEN
  90.       MenuPos% = 8
  91.    ELSE
  92.       MenuPos% = MenuPos% - 1
  93.    END IF
  94.    DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0, 1
  95.    GOTO GetInput
  96. CASE "DOWN"
  97.    DIS.PLAY Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0, 1
  98.    IF MenuPos% = 8 THEN
  99.       MenuPos% = 1
  100.    ELSE
  101.       MenuPos% = MenuPos% + 1
  102.    END IF
  103.    DIS.PLAY Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0, 1
  104.    GOTO GetInput
  105. CASE ""
  106.    ON MenuPos% GOSUB BoxDemo, EolDemo, ClrDemo, DisplayDemo, InputDemo, BltDemo, SendDemo, GoodBye
  107. CASE ELSE
  108.    'Display boo-boo message with a bell and wait 4 seconds
  109.    DIS.PLAY "Invalid selection!", LRED, Blue, 0, 1, 19, 32, 0, 0, 0, 0
  110.    DE.LAY 4
  111.    CLREOL 19, 32, Blue                  'Clear the message off
  112.    GOTO GetInput
  113. END SELECT
  114. GOTO Start                              'Back to the Menu
  115.  
  116.  
  117. BoxDemo:                                'Box.It and Lines demo
  118. '10x15 Box with no borders, shadow or title
  119. ClrScrn WHITE
  120. BOX.IT 2, 2, 11, 16, 0, LWHITE, Blue, Lcyan, Blue, 32, 0, "", 0, 0
  121. 'Tell 'em what it is
  122. DIS.PLAY "10x15 Box", LWHITE, Blue, 0, 0, 3, 4, 0, 0, 0, 0
  123. DIS.PLAY "No Border", LWHITE, Blue, 0, 0, 5, 4, 0, 0, 0, 0
  124. DIS.PLAY "No Title", LWHITE, Blue, 0, 0, 7, 4, 0, 0, 0, 0
  125. DIS.PLAY "No Shadow", LWHITE, Blue, 0, 0, 9, 4, 0, 0, 0, 0
  126.  
  127. 'With border
  128. BOX.IT 2, 21, 11, 36, 2, LWHITE, Blue, Lcyan, Blue, 32, 0, "", 0, 0
  129. DIS.PLAY "Same box", LWHITE, Blue, 0, 0, 5, 24, 0, 0, 0, 0
  130. DIS.PLAY "With border", LWHITE, Blue, 0, 0, 7, 24, 0, 0, 0, 0
  131.  
  132. 'Add a shadow
  133. BOX.IT 2, 41, 11, 56, 2, LWHITE, Blue, Lcyan, Blue, 32, 1, "", 0, 0
  134. DIS.PLAY "Same box", LWHITE, Blue, 0, 0, 5, 44, 0, 0, 0, 0
  135. DIS.PLAY "With shadow", LWHITE, Blue, 0, 0, 7, 44, 0, 0, 0, 0
  136.  
  137. 'Add a title
  138. BOX.IT 2, 61, 11, 76, 2, LWHITE, Blue, Lcyan, Blue, 32, 1, "Title Demo", Lcyan, Red
  139. DIS.PLAY "Same box", LWHITE, Blue, 0, 0, 5, 64, 0, 0, 0, 0
  140. DIS.PLAY "With title", LWHITE, Blue, 0, 0, 7, 64, 0, 0, 0, 0
  141.  
  142. 'Now add some lines
  143. DIS.PLAY "Now let's add some lines to the boxes", LRED, WHITE, 1, 0, 13, 1, 0, 1, 0, 0
  144.  
  145. 'Pause for effect
  146. DE.LAY 2
  147. LINES 4, 2, 15, "H", 0, 2, LWHITE, Blue, LWHITE, Blue
  148. LINES 6, 2, 15, "H", 0, 1, LWHITE, Blue, LWHITE, Blue
  149. LINES 8, 2, 15, "H", 0, 2, LWHITE, Blue, LWHITE, Blue
  150.  
  151. DE.LAY 2
  152. LINES 4, 21, 16, "H", 2, 2, LWHITE, Blue, LWHITE, Blue
  153. LINES 6, 21, 16, "H", 2, 1, LWHITE, Blue, LWHITE, Blue
  154. LINES 8, 21, 16, "H", 2, 2, LWHITE, Blue, LWHITE, Blue
  155.  
  156. DE.LAY 2
  157. LINES 4, 41, 16, "H", 2, 2, LWHITE, Blue, LWHITE, Blue
  158. LINES 6, 41, 16, "H", 2, 1, LWHITE, Blue, LWHITE, Blue
  159. LINES 8, 41, 16, "H", 2, 2, LWHITE, Blue, LWHITE, Blue
  160. LINES 2, 48, 10, "V", 2, 1, LWHITE, Blue, LWHITE, Blue
  161.  
  162. CLREOL 13, 1, WHITE
  163. DIS.PLAY "How about some multi-colored boxes!!", Black, WHITE, 0, 0, 13, 1, 0, 1, 0, 0
  164. DE.LAY 4
  165. 'Draw a big box
  166. BOX.IT 15, 2, 20, 77, 2, LWHITE, Blue, Lcyan, Blue, 32, 1, "Title Demo", Lcyan, Red
  167.  
  168. 'Divide it in 3 parts
  169. LINES 15, 27, 6, "V", 2, 1, LWHITE, Blue, LWHITE, Blue
  170. LINES 15, 52, 6, "V", 2, 1, LWHITE, Blue, LWHITE, Blue
  171.  
  172. 'Color in 2 of them
  173. BOX.IT 16, 28, 19, 51, 0, LWHITE, GREEN, Lcyan, GREEN, 32, 0, "", 0, 0
  174. BOX.IT 16, 53, 19, 76, 0, LWHITE, Red, Lcyan, Red, 32, 0, "", 0, 0
  175.  
  176. ENTER
  177. RETURN
  178.  
  179. EolDemo:                                'ClrEol demo
  180. ClrScrn Black
  181. DIS.PLAY "ClrEol Demo", LWHITE, Black, 0, 0, 1, 1, 0, 1, 0, 0
  182.  
  183. ' Clear 8 lines using each of the background colors
  184. FOR x = 1 TO 7
  185.    CLREOL x + 3, 1, x
  186. NEXT
  187. DIS.PLAY "Clears from specified row/column to the End of Line in 8 Background colors", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0, 0
  188.  
  189. 'Do it again but put 2 different colors on each line
  190. FOR x = 1 TO 7
  191.    CLREOL x + 12, 1, x
  192.    IF x < 4 THEN
  193.       CLREOL x + 12, 41, x + 4
  194.    ELSE
  195.       CLREOL x + 12, 41, x - 3
  196.    END IF
  197. NEXT
  198. DIS.PLAY "Multiple use results in lines with 2 or more colors", LWHITE, Black, 0, 0, 20, 1, 1, 1, 0, 0
  199. ENTER
  200. RETURN
  201.  
  202. ClrDemo:                                'ClrScrn demo
  203. 'Clear the screen using the 8 available background colors
  204. FOR x = 0 TO 7
  205.    ClrScrn x
  206.    IF x = 7 THEN
  207.       '7 = White so change foreground to Black
  208.       DIS.PLAY "ClrScrn Demo using background color" + STR$(x), Black, x, 0, 0, 11, 1, 0, 1, 0, 0
  209.    ELSE
  210.       DIS.PLAY "ClrScrn Demo using background color" + STR$(x), LWHITE, x, 0, 0, 11, 1, 0, 1, 0, 0
  211.    END IF
  212.    DE.LAY 4
  213. NEXT
  214.  
  215. ENTER
  216. RETURN
  217.  
  218. DisplayDemo:                            'Dis.Play demo
  219. 'Demonstrate various ways of using the Dis.Play statement
  220. ClrScrn Black
  221. DIS.PLAY "To demonstrate the Upper/Lower Case, please type a few words with mixed case", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 0
  222. IN.PUT 70, 0, Lcyan, Black, 1, "> ", 10, Black, 12, 1, 1
  223. IF Response$ = "" OR Response$ < "A" THEN
  224.    CLREOL 11, 1, 0
  225.    CLREOL 12, 1, 0
  226.    DIS.PLAY "Ok, fine!", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0, 0
  227. ELSE
  228.    CLREOL 11, 1, 0
  229.    CLREOL 12, 1, 0
  230.    DIS.PLAY "Your response in lower case.", LWHITE, Black, 0, 0, 9, 1, 1, 1, 0, 0
  231.    DIS.PLAY Response$, LWHITE, Black, 0, 0, 11, 1, 1, 1, -1, 0
  232.  
  233.    DE.LAY 4
  234.    CLREOL 9, 1, 0
  235.    CLREOL 11, 1, 0
  236.    DIS.PLAY "Your response in upper case.", LWHITE, Black, 0, 0, 9, 1, 1, 1, 0, 0
  237.    DIS.PLAY Response$, LWHITE, Black, 0, 0, 11, 1, 1, 1, 1, 0
  238. END IF
  239.  
  240. DE.LAY 4
  241. CLREOL 9, 1, 0
  242. CLREOL 11, 1, 0
  243. DIS.PLAY "This is a normal line in White on Black", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 0
  244. DE.LAY 4
  245. CLREOL 11, 1, 0
  246. DIS.PLAY "Blinking White on Black", LWHITE, Black, 1, 0, 11, 1, 1, 0, 0, 0
  247. DE.LAY 4
  248. CLREOL 11, 1, 0
  249. DIS.PLAY "Blinking White on Black and Centered", LWHITE, Black, 1, 0, 11, 1, 1, 1, 0, 0
  250. DE.LAY 4
  251. CLREOL 11, 1, 0
  252. DIS.PLAY "Normal White on Black with |Magenta| and %^Blinking Red^.", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 1
  253. DE.LAY 4
  254. CLREOL 11, 1, 0
  255. DIS.PLAY "Blinking White on Black with {Yellow{ and ~Blue~", LWHITE, Black, 1, 0, 11, 1, 1, 1, 0, 1
  256. DE.LAY 4
  257. CLREOL 11, 1, 0
  258. DIS.PLAY "Normal White on Red with *%}Blinking Low intensity White}", LWHITE, Red, 0, 0, 11, 1, 1, 0, 0, 1
  259. DE.LAY 4
  260. CLREOL 11, 1, 0
  261. DIS.PLAY "Blinking White on Red, Centered, with @Cyan@", LWHITE, Red, 1, 0, 11, 1, 1, 1, 0, 1
  262. DE.LAY 4
  263. CLREOL 11, 1, 0
  264. DIS.PLAY "Well, `you` ~get~ @the@ ^idea^!  }Hit} {the{ %|ENTER| key.", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0, 1
  265. ENTER
  266. RETURN
  267.  
  268.  
  269. InputDemo:                              'In.Put demo
  270. ClrScrn Black
  271. DIS.PLAY "You can tell In.Put how many keystrokes to accept before returning.", LWHITE, Black, 0, 0, 5, 1, 1, 0, 0, 0
  272. DIS.PLAY "You can do %^Hot Keys^ like this:  IN.PUT 1, 0, 10, 0, 1, " + CHR$(34) + CHR$(34) + ", 11, 0, 0, 0, 1", LWHITE, Black, 0, 0, 6, 1, 1, 0, 0, 1
  273. IN.PUT 1, 0, Lgreen, Black, 1, "Hit any key > ", Lcyan, Black, 7, 1, 1
  274.  
  275. IN.PUT 3, 0, LWHITE, Red, 1, "Now type 3 keys > ", Lcyan, Red, 11, 1, 1
  276. DIS.PLAY "As you can see, you may specify fore/background color for the input.", LWHITE, Black, 0, 0, 13, 1, 1, 0, 0, 0
  277. DIS.PLAY "You can specify a wait time in the second parameter of In.Put.", LWHITE, Black, 0, 0, 16, 1, 1, 0, 0, 0
  278. DIS.PLAY "Ex: In.Put 5, 15, 10, 0, 1, " + CHR$(34) + CHR$(34) + ", 11, 0, 0, 0, 1 would wait for 5 chars or 15 seconds.", LWHITE, Black, 0, 0, 17, 1, 1, 0, 0, 0
  279.  
  280. ENTER
  281. RETURN
  282.  
  283. BltDemo:                                'Make.Blt and Show.Blt demo
  284. ClrScrn Black
  285. DIS.PLAY "DoorFrame features two internal Bulletin generators.", LWHITE, Black, 0, 0, 10, 1, 1, 0, 0, 0
  286. DIS.PLAY "Make.Blt generates a Top Ten Listing of the highest scores obtained.", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 0
  287. DIS.PLAY "Make.Blt.Current lists the current score rather than the highest.", LWHITE, Black, 0, 0, 12, 1, 1, 0, 0, 0
  288. DIS.PLAY "We'll demonstrate Make.Blt first. Enter a 5 digit number.", LWHITE, Black, 0, 0, 14, 1, 1, 0, 0, 0
  289. IN.PUT 5, 0, Lgreen, Black, 1, "Score = ", Lcyan, Black, 15, 1, 1
  290. Score& = VAL(Response$)
  291. MAKE.BLT Score&                 'Create the BLT with the number he entered
  292. SHOW.BLT "Y"                    'Now show it to him.
  293.  
  294. ClrScrn Black
  295. DIS.PLAY "Now enter a 4 digit number and we'll demonstrate Make.Blt.Current.", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 0
  296. IN.PUT 4, 0, Lgreen, Black, 1, "Score = ", Lcyan, Black, 12, 1, 1
  297. Score& = VAL(Response$)
  298. MAKE.BLT.CURRENT Score&
  299. SHOW.BLT "Y"
  300. ClrScrn Black
  301. DIS.PLAY "As you can see, Make.Blt.Current uses your current score regardless of your", LWHITE, Black, 0, 0, 11, 1, 1, 0, 0, 0
  302. DIS.PLAY "previous high score. When using Make.Blt, you would have to exceed your", LWHITE, Black, 0, 0, 12, 1, 1, 0, 0, 0
  303. DIS.PLAY "highest score before the bulletin listing would change.", LWHITE, Black, 0, 0, 13, 1, 1, 0, 0, 0
  304. ENTER
  305. RETURN
  306.  
  307. SendDemo:                               'Send demo
  308. ClrScrn Black
  309. DIS.PLAY "First we'll send an ASCII file.", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0, 0
  310. DE.LAY 5
  311. CLREOL 11, 1, 0
  312.  
  313. 'First check for the existance of the files
  314. IF LEN(DIR$("MICRONET.ASC")) > 0 THEN
  315.    SEND "MICRONET.ASC", 1, 1    'Clear the screen, send it, use ENTER prompt
  316. ELSE
  317.    DIS.PLAY "Whoops! Your Sysop does not have that file available!", LRED, Black, 0, 1, 11, 1, 1, 1, 0, 0
  318.    DE.LAY 5
  319.    CLREOL 11, 1, 0
  320. END IF
  321. ClrScrn Black
  322.  
  323. DIS.PLAY "Now we'll send an ANSI file.", LWHITE, Black, 0, 0, 11, 1, 1, 1, 0, 0
  324. DE.LAY 5
  325. CLREOL 11, 1, 0
  326.  
  327. IF LEN(DIR$("MICRONET.ANS")) > 0 THEN
  328.    SENDANSI "MICRONET.ANS", 1
  329. ELSE
  330.    DIS.PLAY "Whoops! Your Sysop does not have that file available!", LRED, Black, 0, 1, 11, 1, 1, 1, 0, 0
  331.    DE.LAY 5
  332.    CLREOL 11, 1, 0
  333. END IF
  334. RETURN
  335.  
  336.  
  337. Err.Routine:
  338. ERRORS ERR, ERL
  339.  
  340. GoodBye:
  341. ClrScrn Black
  342. Mode% = PriorMode%                   'Restore original color mode
  343. EXIT.DOOR "Y"                        'Leave & display ending message
  344. END
  345.  
  346.  
  347.